	PROGRAM COMADATA
	IMPLICIT INTEGER(A-Z)
	DIMENSION A(110),NUM(12),CODES(4),DAT(12),BLANK(6)
	DIMENSION AL(26),MNU(10),CKH(8),COD(6)
	CHARACTER*500 AA,SAM
	CHARACTER*4 CBTT,CB
	CHARACTER*2 CODE(6),CD1(3),CD2(6),CD3(4),CD4(3)
	CHARACTER*2 MONTH
	CHARACTER*7 DATA,BLDATA,DAT,DA
	CHARACTER*12 NUMB
	CHARACTER*27 ALPHA
	DATA CODES/1H1,1H2,1H3,1H4/
	DATA BLANK/1H ,1H ,1H ,1H ,1H ,1H /
	DATA NUM/1,2,3,4,5,6,7,8,9,10,11,12/
	DATA CD1/'01','03','07'/
	DATA MNU/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
	DATA CD2/'14','01','03','13','52','07'/
	DATA CD3/'14','13','52','07'/
	DATA CD4/'14','13','52'/
	DATA AL/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,1HK,1HL,1HM,
     11HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,1HX,1HY,1HZ/
	OPEN(UNIT=1,NAME='FMCOVFC.DAT',TYPE='OLD',RECORDSIZE=500)
	OPEN(UNIT=2,NAME='FMCOVFC.OUT',TYPE='NEW',RECORDSIZE=500)
C
1	FORMAT(108A1)
2	FORMAT(' ','BLANK RECORD',108A1)
9	FORMAT(4A1)
10	FORMAT(2A1)
15	FORMAT(I2)
20	FORMAT(A4,A2,I2,A7)
21	FORMAT(' ','ERROR IN DATA')
25	FORMAT(7A1)
27	FORMAT(Q,500A1)
30	FORMAT(2A1)
31	FORMAT(A,2A2,A)
713	FORMAT(' ',A,2X,A<NOCHR>)
714	FORMAT(' CBTT=',A<NOCHR>,'  DATA CODE=',A2,'  MONTH=',A2)
715	FORMAT(' ','THE CBTT NAME IS GREATER THAN 4 CHRS.',/,' ',108A1)
716	FORMAT(' ','THE DATA CHARACTERS ARE GREATER THAN SIX',/,' ',108A1)
717	FORMAT(' ','THE MONTH IS OUT OF LIMITS',/,' ',108A1)
718	FORMAT(' ','THE DATA CODE IS >16 OR <1',/,' ',108A1)
719	FORMAT(' ','THE DATA CODE IS > 2 CHARACTERS',/,' ',108A1)
720	FORMAT(' ','THE MONTH IS > 2 CHARACTERS',/,' ',108A1)
721	FORMAT(' ',108A1,/,'ILLEGAL RECORD IT WAS IGNORED')
723	FORMAT(' ENCODE ERROR ALPHA DATA PRESENT DATA CODE=',<NCHRS>A1)
724	FORMAT(' ENCODE ERROR ALPHA DATA PRESENT MONTH=',<NCHRS>A1)
725	FORMAT(' ENCODE ERROR ALPHA DATA PRESENT DATA=',<NCHRS>A1)
727	FORMAT(' CBTT NAME ERROR CBTT=',A)
728	FORMAT(' DATA ERROR CBTT=',A,/,'          DATA=',A)
729	FORMAT(' DECODE ERROR MONTH=',A)
730	FORMAT(' DECODE ERROR CODE=',A)
C
	BLDATA='      '
	NUMB=' .0123456789'
	ALPHA=' ABCDEFGHIJKLMNOPQRSTUVWXYZ'
102	CONTINUE
	TYPE=0
	COMA=0
	INLOC=1
	K=0
	ERR=0
C
C
131	DO 232 I=1,8
	CKH(I)=9
232	CONTINUE
	READ(1,1,END=600)(A(I),I=1,108)
	IF(A(1).EQ.1H2.OR.A(1).EQ.1H1)THEN
			DO 233 I=2,5
			DO 234 K=1,10
			IF(A(I).EQ.MNU(K))CKH(I)=1
234			CONTINUE
233			CONTINUE
			DO 235 I=2,5
			IF(CKH(I).NE.1)GO TO 722
235			CONTINUE
			IF(A(6).NE.BLANK(1))GO TO 722
	END IF
	IF(A(1).EQ.1H2)GO TO 700
	IF(A(1).EQ.1H1)GO TO 500
	DO 236 I=1,3
	DO 237 K=1,26
	IF(A(I).EQ.AL(K))CKH(I)=2
237	CONTINUE
236	CONTINUE
	DO 238 I=1,3
	IF(CKH(I).NE.2)GO TO 722
238	CONTINUE
	GO TO 100
722	WRITE(6,721)(A(I),I=1,108)
	GO TO 131
C
100	DO 200 I=1,108
	N=109-I
	IF(A(109-I).NE.1H )GO TO 101
200	CONTINUE
C
	WRITE(6,2)(A(I),I=1,108)
C
	GO TO 102
101	IF(A(109-I).NE.1H,)THEN
	   A(109-I+1)=1H,
	   N=N+1
	END IF
	DO 201 K=1,N
	IF(A(K).NE.1H,)GO TO 201
	COMA=COMA+1
	ENDLOC=K-1
	BEGLOC=INLOC
	INLOC=K+1
	NCHRS=ENDLOC-BEGLOC+1
C
      GO TO(1001,1002,1003,1004,1004,1004,1004,1004,1004,1004,1004,1004,
     1      1004,1004,1004)COMA
C
1001	DO 202 B=1,4
	IF(A(ENDLOC).EQ.CODES(B))GO TO 203
202	CONTINUE
	TYPE=1
	CBTCHRS=ENDLOC-BEGLOC+1
	CBTBLNS=4-CBTCHRS
	IF(CBTBLNS.GT.0)ENCODE(4,9,CBTT)(A(I),I=BEGLOC,ENDLOC),
     1                                (BLANK(I),I=1,CBTBLNS)
	IF(CBTBLNS.EQ.0)ENCODE(4,9,CBTT)(A(I),I=BEGLOC,ENDLOC)
	GO TO 201
203	CBTCHRS=ENDLOC-BEGLOC
	GO TO(2001,2002,2003,2004)B
2001	DO 105 I=1,3
	CODE(I)=CD1(I)
105	CONTINUE
	CODNO=3
	GO TO 3000
2002	DO 103 I=1,6
	CODE(I)=CD2(I)
103	CONTINUE
	CODNO=6
	GO TO 3000
2003	DO 104 I=1,4
	CODE(I)=CD3(I)
104	CONTINUE
	CODNO=4
	GO TO 3000
2004	DO 106 I=1,3
	CODE(I)=CD4(I)
106	CONTINUE
	CODNO=3
3000	CODECHRS=2
	CBTBLNS=4-CBTCHRS
	IF(CBTBLNS.GT.0)ENCODE(4,9,CBTT) (A(I),I=BEGLOC,ENDLOC-1),
     1                                 (BLANK(I),I=1,CBTBLNS)
	IF(CBTBLNS.EQ.0)ENCODE(4,9,CBTT) (A(I),I=BEGLOC,ENDLOC-1)
	GO TO 201
C
C
C
1002	IF(TYPE.NE.1)GO TO 107
	IF(ENDLOC.EQ.BEGLOC)ENCODE(2,10,CODE(1),ERR=260)BLANK(1),A(BEGLOC)
	IF(ENDLOC.NE.BEGLOC)ENCODE(2,10,CODE(1),ERR=260)A(BEGLOC),A(ENDLOC)
	CODNO=1
	GO TO 201
107	IF(NCHRS.GT.2)THEN
			ERR=1
			WRITE(6,720)(A(I),I=1,108)
			END IF
	IF(ENDLOC.EQ.BEGLOC)ENCODE(2,10,MONTH,ERR=261)BLANK(1),A(BEGLOC)
	IF(ENDLOC.NE.BEGLOC)ENCODE(2,10,MONTH,ERR=261)A(BEGLOC),A(ENDLOC)
	GO TO 201
C
1003	IF(TYPE.NE.1)GO TO 1004
	IF(NCHRS.GT.2)THEN
			ERR=1
			WRITE(6,719)(A(I),I=1,108)
			END IF
	IF(ENDLOC.EQ.BEGLOC)ENCODE(2,10,MONTH,ERR=262)BLANK(1),A(BEGLOC)
	IF(ENDLOC.NE.BEGLOC)ENCODE(2,10,MONTH,ERR=262)A(BEGLOC),A(ENDLOC)
	GO TO 201
C
1004	DATCHRS=ENDLOC-BEGLOC+1
	IF(DATCHRS.GT.7)THEN
			WRITE(6,716)(A(I),I=1,108)
			END IF
	DATBNKS=7-DATCHRS
	IF(TYPE.EQ.1)DNO=COMA-3
	IF(TYPE.NE.1)DNO=COMA-2
	IF(DATBNKS.GT.0)ENCODE(7,25,DAT(DNO),ERR=263)(BLANK(I),I=1,DATBNKS),
     1                                     (A(I),I=BEGLOC,ENDLOC)
	IF(DATBNKS.EQ.0)ENCODE(7,25,DAT(DNO),ERR=263)(A(I),I=BEGLOC,ENDLOC)
	GO TO 201
260	WRITE(6,723)(A(I),I=BEGLOC,ENDLOC)
	ER='EN'
	GO TO 201
261	WRITE(6,724)(A(I),I=BEGLOC,ENDLOC)
	ER='EN'
	GO TO 201
262	WRITE(6,724)(A(I),I=BEGLOC,ENDLOC)
	ER='EN'
	GO TO 201
263	WRITE(6,725)(A(I),I=BEGLOC,ENDLOC)
	ER='EN'
201	CONTINUE
	IF(CBTCHRS.GT.4)THEN
			WRITE(6,715)(A(I),I=1,108)
			ERR=1
			END IF
C
C
270	DECODE(2,15,MONTH,ERR=264)MONT
	IF(MONT.GT.12.OR.MONT.LT.0)THEN
			WRITE(6,717)(A(I),I=1,108)
			ERR=1
			END IF
	GO TO 268
264	WRITE(6,729)MONTH
	ER='EN'
268	DECODE(2,15,CODE(1),ERR=267)COD(1)
	IF(COD(1).GT.16.OR.COD(1).LT.1)THEN
		WRITE(6,718)(A(I),I=1,108)
		ERR=1
		END IF
	GO TO 269
267	WRITE(6,730)CODE(1)
	ER='EN'
269	IF(A(1).EQ.1H2)THEN
		IF(ERR.EQ.1)THEN
			READ(1,27,END=600)LENGTH,(AA(I:I),I=1,LENGTH)
			GO TO 102
			END IF
		GO TO 701
		END IF
	IF(ERR.EQ.1)GO TO 102
	IF(ER.EQ.'EN')GO TO 102
C
	IF(TYPE.NE.1)GO TO 210
	DO 300 I=1,DNO
	WRITE(2,20)CBTT,CODE(1),MONT,DAT(I)
	MONT=MONT+1
	IF(MONT.EQ.13)MONT=1
300	CONTINUE
	GO TO 102
C
C
210	DO 301 I=1,DNO
	IF(DNO.GT.CODNO)GO TO 599
	WRITE(2,20)CBTT,CODE(I),MONT,DAT(I)
301	CONTINUE
	GO TO 102
599	WRITE(3,21)
	GO TO 102
700	ENCODE(2,30,CODE(1)) A(2),A(3)
	ENCODE(2,30,MONTH) A(4),A(5)
	GO TO 270
701	READ(1,27,END=600)LENGTH,(AA(I:I),I=1,LENGTH)
	AA(LENGTH+1:)=' '
	SWITCH=1
	SKIP=1
	BEGPOS=1
	IF(AA(LENGTH:LENGTH).NE.',')THEN
			   AA(LENGTH+1:LENGTH+1)=','
			   LENGTH=LENGTH+1
	END IF
204	CONTINUE
265	POS=INDEX(AA(BEGPOS:),',')+BEGPOS-1
	TPOS=POS-BEGPOS+1
	IF(TPOS.EQ.0)GO TO 102
	OLDPOS=BEGPOS
	BEGPOS=POS+1
	KW=SWITCH
	IF(SKIP.EQ.0)THEN
		SKIP=1
		GO TO 265
		END IF
	IF(SWITCH.EQ.1)THEN
			SWITCH=2
			NOCHR=POS-1-OLDPOS+1
			IF(NOCHR.GT.4)THEN
			PRINT*,'CBTT STATION IS GREATER THAN 4 CHRS.'
			WRITE(6,714)AA(OLDPOS:POS-1),CODE(1),MONTH
			CB='ERRO'
			GO TO 205
			END IF
			CBTT=AA(OLDPOS:POS-1)
			SWITCH=2
			DO 240 J=1,NOCHR
			SKIP=0
			DO 241 I=1,27
			IF(CBTT(J:J).EQ.ALPHA(I:I))SKIP=1
241	CONTINUE
			IF(SKIP.EQ.0)THEN
				WRITE(6,727)CBTT
				SWITCH=1
				GO TO 204
			END IF
240	CONTINUE
	END IF
205	IF(KW.EQ.1)GO TO 204
	IF(SWITCH.EQ.2)THEN
			NOCHR=POS-1-OLDPOS+1                                             
			IF(NOCHR.GT.7)THEN
					PRINT*,'DATA FOR CBTT STATION IS GREATER THAN 7 CHRS.'
					WRITE(6,713)CBTT,AA(OLDPOS:POS-1)
					SWITCH=1
					DA='ERROR '
					GO TO 206
					END IF
			DATA=AA(OLDPOS:POS-1)
			NOB=7-NOCHR
			IF(NOB.GE.1)DATA=BLDATA(1:NOB)//AA(OLDPOS:POS-1)
206			IF(DA.EQ.'ERROR '.OR.CB.EQ.'ERRO')THEN
				SWITCH=1
				DA='      '
				CB='    '
				GO TO 204
				END IF
			DO 242 I=1,6
			MAT=0
			DO 243 J=1,12
			IF(DATA(I:I).EQ.NUMB(J:J))MAT=1
243			CONTINUE
			IF(MAT.EQ.0)THEN
				WRITE(6,728)CBTT,DATA
				GO TO 266
				END IF
242			CONTINUE
			WRITE(2,31)CBTT,CODE(1),MONTH,DATA
266			SWITCH=1
	END IF
	GO TO 204
500	READ(1,1,END=600)A
	IF(A(1).EQ.1H1)GO TO 102
	WRITE(2,1)A
	GO TO 500
600	CALL EXIT
	END
